home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d996.lha
/
Startup-Menu
/
Source
/
SM
/
Window.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-05
|
7KB
|
212 lines
(* ===================================================================== *)
Procedure RefreshWin;
begin
GT_BeginRefresh(TheWindow);
GT_EndRefresh(TheWindow, True);
end;
(* ===================================================================== *)
Procedure ErrExit(Errortxt : string; ExitCode : integer);
VAR OK : Boolean;
Begin
ErrorExit('** Startup-Menu Error **'#0, Errortxt);
CloseLibrary(pLibrary(IntuitionBase));
If GadToolsBase <> NIL then CloseLibrary(pLibrary(GadtoolsBase));
If GfxBase <> NIL then CloseLibrary(pLibrary(GfxBase));
If DiskFontBase <> NIL then CloseLibrary(pLibrary(DiskFontBase));
If TheWindow <> NIL then CloseWindow(TheWindow);
If TheScreen <> NIL then OK := CloseScreen(TheScreen);
If vi <> NIL then FreeVisualInfo(vi);
FreeRemember(@RememberKey, True);
Halt(exitcode);
end;
(* ===================================================================== *)
Procedure open_window;
Var
DTags : Array[0..17] Of tTagItem;
tags : Array[0..3] of tTagItem;
node : pMyNode;
SampTxt : tIntuiText;
n,i : integer;
err : long;
Begin
WindowIDCMP := IDCMP_REFRESHWINDOW | BUTTONIDCMP |
IDCMP_MOUSEBUTTONS | IDCMP_VANILLAKEY;
pgad := NIL;
(* Make sure w've got an openable TextAttr *)
GetMem(MyTextFont, sizeof(tTextFont));
MyTextFont := OpenDiskFont(@CD.cd_Font);
If MyTextFont = NIL then begin { default to topaz 8 if unsuccesful }
With CD.cd_Font do begin
ta_Name := CStrConstPtr('topaz.font');
ta_YSize := 8;
ta_Style := 0;
ta_Flags := FPF_ROMFONT;
end;
MyTextFont^.tf_XSize := 6;
end;
DTags[0].ti_Tag := SA_Type;
DTags[0].ti_Data := CUSTOMSCREEN;
DTags[1].ti_Tag := SA_Title;
DTags[1].ti_Data := LONG(@CD.cd_ScrTit[1]);
DTags[2].ti_Tag := SA_OverScan;
DTags[2].ti_Data := OSCAN_TEXT;
DTags[3].ti_Tag := SA_Depth;
DTags[3].ti_Data := 2;
DTags[4].ti_Tag := SA_Font;
DTags[4].ti_Data := LONG(@CD.cd_Font);
DTags[5].ti_Tag := SA_DisplayID;
DTags[5].ti_Data := CD.cd_ModeID;
DTags[6].ti_Tag := SA_Width;
DTags[6].ti_Data := STDSCREENWIDTH;
DTags[7].ti_Tag := SA_Height;
DTags[7].ti_Data := STDSCREENHEIGHT;
DTags[8].ti_Tag := SA_Pens;
DTags[8].ti_Data := LONG(@MyPens);
DTags[9].ti_Tag := SA_ErrorCode;
DTags[9].ti_Data := LONG(@Err);
DTags[10].ti_Tag := TAG_END;
TheScreen := OpenScreenTagList(NIL, @DTags);
IF TheScreen = NIL then begin
Case Err of
OSERR_NOMONITOR : ErrExit('Can''t open screen, monitor required not available (Monitor not installed?)'#0, 10);
OSERR_NOCHIPS : ErrExit('Can''t open screen, Newer custom chips required'#0, 10);
OSERR_UNKNOWNMODE : ErrExit('Can''t open screen, Unknown ModeID (Monitor no installed?)'#0, 10);
ELSE ErrExit('Can''t open screen'#0, 10);
end;
end;
LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
(* Get visual info and create context *)
vi := GetVisualInfoA(TheScreen, NIL);
If vi = NIL Then
ErrExit('Failed to get visual info'#0, 10);
pGad := CreateContext(@glist);
if pgad = NIL then
ErrExit('Failed to create Context'#0, 10);
(* Get some data from the screen *)
node := pMyNode(CurrentList^.lh_Head);
tmpstr := node^.LSK_Name;
While pMyNode(node^.LSK_Node.ln_Succ) <> NIL do begin
If length(tmpstr) < length(node^.LSK_Name) then
tmpstr := node^.LSK_Name;
node := pMyNode(node^.LSK_Node.ln_Succ);
end;
SampTxt.ITextFont := @CD.cd_Font;
SampTxt.IText := @TmpStr[1];
Sizes[GAD_W] := IntuiTextLength(@SampTxt) + 30 ;
FreeMem(MyTextFont, sizeof(tTextFont));
Sizes[TBS] := TheScreen^.WBorTop + (TheScreen^.Font^.ta_YSize + 1);
Sizes[Gad_H] := sizes[TBS];
sizes[S_WB_T] := TheScreen^.WBorTop;
sizes[S_WB_L] := TheScreen^.WBorLeft;
sizes[S_WB_R] := TheScreen^.WBorRight;
sizes[S_WB_B] := TheScreen^.WBorBottom;
Tags[0].ti_Tag := GTTX_Text;
Tags[0].ti_Data := LONG(NIL);
Tags[1].ti_Tag := GTTX_Border;
Tags[1].ti_Data := True_;
Tags[2].ti_Tag := GTTX_CopyText;
Tags[2].ti_Data := True_;
Tags[3].ti_Tag := TAG_END;
With GadgetFlags Do Begin
ng_TextAttr := @CD.cd_Font;
ng_LeftEdge := sizes[S_WB_L]+2;
ng_Width := Sizes[GAD_W];
ng_Height := Sizes[GAD_H];
ng_VisualInfo := vi;
End;
node := pMyNode(CurrentList^.lh_Head);
For n := 1 to CD.cd_Down do begin { traverse down list creating gadgets }
GadgetFlags.ng_TopEdge := Sizes[TBS] + 1 + (n-1)*(Sizes[GAD_H]+1);
For i := 1 to CD.cd_Across do begin
With GadgetFlags Do Begin
ng_LeftEdge := sizes[S_WB_L] + (i-1)*(ng_Width+4);
If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then begin
IF node^.LSK_Cmd = 'None'#0 then begin
Tags[0].ti_Data := LONG(@node^.LSK_Name[1]);
ng_GadgetText := NIL;
pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @Tags);
end else begin
ng_GadgetText := CstrConstPtr(node^.LSK_Name);
ng_UserData := CStrConstPtr(node^.LSK_Cmd);
pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, NIL);
end;
end else begin (* We dont want to traverse out of the list *)
Tags[0].ti_Data := LONG(NIL);
ng_GadgetText := NIL;
pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @tags);
End;
End;
pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, NIL);
If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then
node := pMyNode(node^.LSK_Node.ln_Succ);
end;
end;
If pGad = NIL Then
ErrExit('Failed to create gadgets'#0, 10);
(* window structure *)
DTags[0].ti_Tag := WA_Width;
DTags[0].ti_Data := GadgetFlags.ng_LeftEdge+GadgetFlags.ng_Width+4;
DTags[1].ti_Tag := WA_Height;
DTags[1].ti_Data := GadgetFlags.ng_TopEdge+GadgetFlags.ng_Height+3;
DTags[2].ti_Tag := WA_Left;
DTags[2].ti_Data := (TheScreen^.Width div 2) - (DTags[0].ti_Data div 2);
DTags[3].ti_Tag := WA_Top;
DTags[3].ti_Data := (TheScreen^.Height div 2) - (DTags[1].ti_Data div 2);
DTags[4].ti_Tag := WA_Title;
DTags[4].ti_Data := LONG(@CD.cd_WinTit[1]);
DTags[5].ti_Tag := WA_IDCMP;
DTags[5].ti_Data := WindowIDCMP;
DTags[6].ti_Tag := WA_CloseGadget;
DTags[6].ti_Data := False_;
DTags[7].ti_Tag := WA_DragBar;
DTags[7].ti_Data := True_;
DTags[8].ti_Tag := WA_DepthGadget;
DTags[8].ti_Data := False_;
DTags[9].ti_Tag := WA_AutoAdjust;
DTags[9].ti_Data := True_;
DTags[10].ti_Tag := WA_Activate;
DTags[10].ti_Data:= True_;
DTags[11].ti_Tag := WA_Gadgets;
DTags[11].ti_Data:= LONG(glist);
DTags[12].ti_Tag := WA_SimpleRefresh;
DTags[12].ti_Data:= True_;
DTags[13].ti_Tag := WA_RMBTrap;
DTags[13].ti_Data:= True_;
DTags[14].ti_Tag := WA_CustomScreen;
DTags[14].ti_Data:= LONG(TheScreen);
DTags[15].ti_Tag := TAG_DONE;
TheWindow := OpenWindowTaglist(NIL,@DTags);
If TheWindow = NIL Then
ErrExit('Failed to create window'#0, 206);
GT_RefreshWindow(TheWindow, NIL);
End;